home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist02.zoo / sources / xlpp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-11-09  |  3.0 KB  |  175 lines
  1. /* xlpp.c - xlisp pretty printer */
  2. /*        Copyright (c) 1985, by David Betz
  3.         All Rights Reserved                        */
  4.  
  5. #include "xlisp.h"
  6.  
  7. /* external variables */
  8. extern LVAL s_stdout;
  9. extern int xlfsize;
  10.  
  11. /* local variables */
  12. static int pplevel,ppmargin,ppmaxlen;
  13. static LVAL ppfile;
  14.  
  15. /* forward declarations */
  16. #ifdef ANSI
  17. void pp(LVAL expr);
  18. void pplist(LVAL expr);
  19. void ppexpr(LVAL expr);
  20. void ppputc(int ch);
  21. void ppterpri(void);
  22. int  ppflatsize(LVAL expr);
  23. #else
  24. FORWARD VOID pp();
  25. FORWARD VOID pplist();
  26. FORWARD VOID ppexpr();
  27. FORWARD VOID ppputc();
  28. FORWARD VOID ppterpri();
  29. #endif
  30.  
  31. #ifdef PRINDEPTH
  32. extern LVAL s_printlevel, s_printlength;    /*modified for depth/length ctrl*/
  33. extern FIXTYPE plevel, plength;
  34. #define xlprint xlprintl
  35. #endif
  36.  
  37. /* xpp - pretty-print an expression */
  38. LVAL xpp()
  39. {
  40.     LVAL expr;
  41.  
  42. #ifdef PRINDEPTH
  43.  
  44.     /* get printlevel and depth values */
  45.     expr = getvalue(s_printlevel);
  46.     if (fixp(expr)) {
  47.         plevel = getfixnum(expr);
  48.     }
  49.     else {
  50.         plevel = 32767;
  51.     }
  52.     expr = getvalue(s_printlength);
  53.     if (fixp(expr)) {
  54.         plength = getfixnum(expr);
  55.     }
  56.     else
  57.         plength = 32767;
  58. #endif
  59.  
  60.     /* get expression to print and file pointer */
  61.     expr = xlgetarg();
  62.     ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
  63.     xllastarg();
  64.  
  65.     /* pretty print the expression */
  66.     pplevel = ppmargin = 0; ppmaxlen = 40;
  67.     pp(expr); ppterpri();
  68.  
  69.     /* return nil */
  70.     return (NIL);
  71. }
  72.  
  73. /* pp - pretty print an expression */
  74. LOCAL VOID pp(expr)
  75.   LVAL expr;
  76. {
  77.     if (consp(expr))
  78.         pplist(expr);
  79.     else
  80.         ppexpr(expr);
  81. }
  82.  
  83. /* pplist - pretty print a list */
  84. LOCAL VOID pplist(expr)
  85.   LVAL expr;
  86. {
  87.     int n;
  88.  
  89.     /* if the expression will fit on one line, print it on one */
  90.     if ((n = ppflatsize(expr)) < ppmaxlen) {
  91.         xlprint(ppfile,expr,TRUE);
  92.         pplevel += n;
  93.     }
  94.  
  95.     /* otherwise print it on several lines */
  96.     else {
  97. #ifdef PRINDEPTH
  98.         FIXTYPE llength = plength;
  99.  
  100.         if (plevel-- == 0) {
  101.             ppputc('#');
  102.             plevel++;
  103.             return;
  104.         }
  105. #endif
  106.  
  107.         n = ppmargin;
  108.         ppputc('(');
  109.         if (atom(car(expr))) {
  110.             ppexpr(car(expr));
  111.             ppputc(' ');
  112.             ppmargin = pplevel;
  113.             expr = cdr(expr);
  114.         }
  115.         else
  116.             ppmargin = pplevel;
  117.         for (; consp(expr); expr = cdr(expr)) {
  118. #ifdef PRINDEPTH
  119.             if (llength-- == 0) {
  120.                 xlputstr(ppfile,"... )");
  121.                 pplevel += 5;
  122.                 ppmargin =n;
  123.                 plevel++;
  124.                 return;
  125.             }
  126. #endif
  127.             pp(car(expr));
  128.             if (consp(cdr(expr)))
  129.                 ppterpri();
  130.         }
  131.         if (expr != NIL) {
  132.             ppputc(' '); ppputc('.'); ppputc(' ');
  133.             ppexpr(expr);
  134.         }
  135.         ppputc(')');
  136.         ppmargin = n;
  137. #ifdef PRINDEPTH
  138.         plevel++;
  139. #endif
  140.     }
  141. }
  142.  
  143. /* ppexpr - print an expression and update the indent level */
  144. LOCAL VOID ppexpr(expr)
  145.   LVAL expr;
  146. {
  147.     xlprint(ppfile,expr,TRUE);
  148.     pplevel += ppflatsize(expr);
  149. }
  150.  
  151. /* ppputc - output a character and update the indent level */
  152. LOCAL VOID ppputc(ch)
  153.   int ch;
  154. {
  155.     xlputc(ppfile,ch);
  156.     pplevel++;
  157. }
  158.  
  159. /* ppterpri - terminate the print line and indent */
  160. LOCAL VOID ppterpri()
  161. {
  162.     xlterpri(ppfile);
  163.     for (pplevel = 0; pplevel < ppmargin; pplevel++)
  164.         xlputc(ppfile,' ');
  165. }
  166.  
  167. /* ppflatsize - compute the flat size of an expression */
  168. LOCAL int ppflatsize(expr)
  169.   LVAL expr;
  170. {
  171.     xlfsize = 0;
  172.     xlprint(NIL,expr,TRUE);
  173.     return (xlfsize);
  174. }
  175.